home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / picklst.exe / DIALOGS1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-26  |  13KB  |  472 lines
  1. unit Dialogs1;
  2.  
  3. {************************************************}
  4. {                                                }
  5. {   Turbo Pascal 6.0                             }
  6. {   Turbo Vision Unit - Dialogs1                 }
  7. {                                                }
  8. {   Containing:                                  }
  9. {   tSelectItem, tSelectCollection,              }
  10. {   tPickList, tPickDialog                       }
  11. {   tTextDialog                                  }
  12. {                                                }
  13. {************************************************}
  14. {********************************}
  15. {***Programmed by             ***}
  16. {***Blake Watson              ***}
  17. {***CIS number 70303,373      ***}
  18. {********************************}
  19. interface
  20.  
  21. uses Objects, Drivers, Dialogs, Views, MsgBox, App,
  22.      Objects1;
  23.  
  24. const
  25.    MaxRows = 21;
  26.  
  27. type
  28.    pSelectItem = ^tSelectItem;
  29.    tSelectItem = object(tObject)
  30.       Name    : pString;
  31.       Selected: boolean;
  32.       constructor Init(S:String);
  33.       destructor Done; virtual;
  34.       end;
  35.  
  36.    pSelectCollection = ^tSelectCollection;
  37.    tSelectCollection = object(tCollection)
  38.       Pick: byte;
  39.       constructor Init(S:string);
  40.       function NameAt(I:Integer): string;
  41.       procedure NewItem(S:String); virtual;
  42.       function Selected(I:Integer): boolean;
  43.       procedure ToggleAt(I:Integer);
  44.       procedure DropNotSelected;
  45.       function LastSelectedItem: integer;
  46.       function NumberSelected: integer;
  47.       end;
  48.  
  49.    pPickList = ^tPickList;
  50.    tPickList = object(tView)
  51.       List  : PSelectCollection;
  52.       MaxItemLength, Picked, Highlight, NumRows,
  53.       NumCols: integer;
  54.       constructor Init(r: tRect; MIL, NC, NR: integer; AList: pSelectCollection);
  55.       procedure Draw; virtual;
  56.       procedure Choose(AnItem: Integer); virtual;
  57.       procedure HandleEvent(var Event:tEvent); virtual;
  58.       end;
  59.  
  60.    pPickDialog = ^tPickDialog;
  61.    tPickDialog = object(tDialog)
  62.       constructor Init(AList: pointer; X,Y: Integer);
  63.       procedure GetDims(var r: tRect; var W, Columns, rows: integer; Alist: pSelectCollection);
  64.       end;
  65.  
  66.    {tPickDialog is the first "useful" object.  Pass a tRect, a width, number of
  67.     columns and rows, and a TSelectCollection, and it will allow the user to
  68.     select up to <pick> items, marking the <selected> field of those items.}
  69.  
  70.    pTextDialog = ^tTextDialog;
  71.    tTextDialog = object(tPickDialog)
  72.       IsValid : boolean;
  73.       List    : pSelectCOllection;
  74.       constructor Init(var AList: pointer; X,Y: Integer; fn: string; name: string);
  75.       function LoadList(var fn, name, h: string; var temp: pCollection): boolean;
  76.       procedure InitList(h:string; t:pCollection); virtual;
  77.       function Valid(Command: Word): Boolean; virtual;
  78.       destructor Done; virtual;
  79.       end;
  80.  
  81.    {tTextDialog is a little more complex.  You pass an empty TSelectCollection,
  82.     the coords for where the list should appear, and it figures out how large
  83.     the dialog has to be.  The TSelectCollection is built from a list (spec'ed
  84.     by <name>) in a text file <fn>.
  85.  
  86.     The text file may have many lists in it, and follows this format:
  87.  
  88.     NumberOfItems,ListName,NumberToPick
  89.     Item
  90.     Item
  91.     ....
  92.     NumberOfItems,ListName,NumberToPick
  93.     ....
  94.  
  95.     tTextDialog returns ONLY the items that have been selected.}
  96.  
  97. function GetElement(S:String; N:byte): string;
  98. function GetNumericElement(S:String; N:byte): longint;
  99.  
  100. implementation
  101.  
  102. function GetElement(S:String; N:byte): string;
  103. var I,J,K: byte;
  104. begin
  105.    I := 1; J := 0;
  106.    while(pos(',',S)>0) and (I<>N) do
  107.    begin
  108.       J := pos(',',s);
  109.       inc(I);
  110.       s[j] := ' ';
  111.       end;
  112.    If I<>N then GetElement := ''
  113.    else begin
  114.       inc(J);
  115.       K := pos(',',S);
  116.       If K = 0 then K := Length(S) + 1;
  117.       GetElement := copy(S,J,K-J);
  118.       end;
  119.    end;
  120.  
  121. function GetNumericElement(S:String; N:byte): longint;
  122. var l:longint; code:integer;
  123. begin
  124.    s := GetElement(S,N);
  125.    val(s,l,code);
  126.    GetNumericElement := l;
  127.    end;
  128.  
  129. {tSelectItem}
  130.  
  131. constructor tSelectItem.Init(S:String);
  132. var w: byte;
  133. begin
  134.    tObject.Init;
  135.    w := pos('  ',s);
  136.    if w = 0 then w := length(S);
  137.    Name := newStr(copy(S,1,w));
  138.    selected := false;
  139.    end;
  140.  
  141. destructor tSelectItem.Done;
  142. begin
  143.    DisposeStr(Name);
  144.    end;
  145.  
  146. {tSelectCollection}
  147.  
  148. constructor tSelectCollection.Init(S:String);
  149. begin
  150.    tCollection.Init(GetNumericElement(s,1),0);
  151.    Pick := GetNumericElement(s,3);
  152.    If Pick = 0 then Pick := 1;
  153.    end;
  154.  
  155. function tSelectCollection.NameAt(I: Integer): string;
  156. begin
  157.    NameAt := tSelectItem(At(I)^).Name^;
  158.    end;
  159.  
  160. function tSelectCollection.Selected(I: Integer): boolean;
  161. begin
  162.    Selected := tSelectItem(At(I)^).Selected;
  163.    end;
  164.  
  165. procedure tSelectCollection.ToggleAt(I: Integer);
  166. begin
  167.    tSelectItem(At(I)^).Selected := not tSelectItem(At(I)^).Selected;
  168.    end;
  169.  
  170. procedure tSelectCollection.DropNotSelected;
  171. var I: Integer;
  172. begin
  173.    for I := Count-1 downto 0 do
  174.       if not tSelectItem(At(I)^).Selected
  175.          then Free(At(I));
  176.    end;
  177.  
  178. procedure tSelectCollection.NewItem(S:string);
  179. begin
  180.    Insert(New(pSelectItem, init(S)));
  181.    end;
  182.  
  183. function tSelectCollection.LastSelectedItem: integer;
  184. var I: integer;
  185. begin
  186.    I := Count;
  187.    repeat dec(i) until (I=0) or Selected(I);
  188.    LastSelectedItem := I;
  189.    end;
  190.  
  191. function tSelectCollection.NumberSelected: integer;
  192. var I, J: integer;
  193. begin
  194.    J := 0;
  195.    for I := 0 to Count -1 do
  196.        if Selected(I) then inc(J);
  197.    NumberSelected := J;
  198.    end;
  199.  
  200.  
  201. {tPICKLIST}
  202.  
  203. constructor tPickList.Init;
  204. var I : integer;
  205.     p : pointer;
  206. begin
  207.    tview.init(R);
  208.    EventMask := EventMask or evMouseMove;
  209.    Options := ofSelectable or ofTopSelect or ofPreProcess or ofCentered;
  210.  
  211.    List := AList;
  212.    MaxItemLength := MIL;
  213.    NumCols := NC;
  214.    NumRows := NR;
  215.    picked := 0;
  216.    for I := 0 to List^.Count -1 do
  217.       if List^.Selected(I) then inc(picked);
  218.  
  219.    end;
  220.  
  221. procedure tPickList.Draw;
  222. var I, X, Y : byte;
  223.     s       : string;
  224. begin
  225.    X := 0; Y := 0;
  226.    for I := 0 to List^.Count-1 do
  227.    begin
  228.       If Y + 1 > NumRows then
  229.       begin
  230.          Y := 0;
  231.          Inc(X, MaxItemLength);
  232.          end;
  233.                            {This code guarantees that s fills all space}
  234.       S := List^.NameAt(I);
  235.       while(Length(S)<MaxItemLength) do s := S + ' ';
  236.  
  237.       if I = Highlight then writeStr(X, Y, s, 11)
  238.       else if List^.Selected(I) then writeStr(X,Y,S,3)
  239.       else writeStr(x,y,S,1);
  240.       Inc(y);
  241.       end;
  242.  
  243.    S := '';
  244.    while(Length(S)<MaxItemLength) do s := S + ' ';
  245.    while(Y<=NumRows) do
  246.    begin
  247.       writestr(X,Y,S,1);
  248.       inc(y);
  249.       end;
  250.  
  251.    end;
  252.  
  253. procedure tPickList.Choose(AnItem: Integer);
  254. begin
  255.    If tSelectItem(List^.At(AnItem)^).Selected then dec(picked)
  256.    else inc(picked);
  257.    tSelectItem(List^.At(AnItem)^).Selected :=
  258.       not tSelectItem(List^.At(AnItem)^).Selected;
  259.    end;
  260.  
  261. procedure tPickList.HandleEvent;
  262. var CoOrds: TPoint;
  263.     OH,I,J: integer;
  264.     r     : tRect;
  265.     P     : Pview;
  266.     s     : string;
  267. begin
  268.    tView.HandleEvent(Event);
  269.    If Event.What and (evBroadCast or evCommand) = 0 then
  270.    begin
  271.       Oh := Highlight;
  272.       if (event.What and evKeyboard <> 0) then
  273.       begin
  274.          case event.KeyCode of
  275.             kbDown : Inc(Highlight);
  276.             kbUp   : Dec(Highlight);
  277.             kbRight: if numcols>1 then inc(Highlight,NumRows);
  278.             kbLeft : if numcols>1 then dec(Highlight,NumRows);
  279.             else
  280.                if Event.CharCode in [' ',#13] then
  281.                begin
  282.                  If (Event.charCode = ' ') or not List^.Selected(Highlight)
  283.                  then Choose(Highlight);
  284.                  if Event.CharCode = #13 then picked := List^.pick;
  285.                  end
  286.             else begin
  287.                I := Highlight; J := 0;
  288.                repeat
  289.                   inc(I); Inc(J);
  290.                   If I = List^.Count then I := 0;
  291.                   If I < List^.Count then S := List^.NameAt(I);
  292.                   un